COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE WRDCNT
C00007 00003		EXTERN JOBFF,JOBREL
C00009 00004	FILNAM:	SIXBIT/ANA/
C00010 00005	SA:	
C00011 00006	
C00012 ENDMK
C⊗;
TITLE WRDCNT
	OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]↔OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
	OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF DZM[SETZM]↔OPDEF GO[JRST]
	OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
	↓P←←17
	DEFINE POP0J<POPJ P,>
	↓POP1J.:↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
	DEFINE ACCUMULATORS(LIST){ACPTR←←2	;DECLARE ACCUMULATORS.
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){FOR VARNAM⊂(LIST)<VARNAM:0↔>}
	DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
;FATAL ERROR MESSAGE.
	DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
	FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
	OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
	%←400000
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0 ↔ .SLEVEL←←0	;PDL COUNT & DEPTH OF SUBR NESTING.
;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↓NAME:;}
;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }
;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;STACK ACCESSING MACROS  -  PUSHP & POPP.
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
	EXTERN JOBFF,JOBREL
SUBR(INFILE)	INDIRECT FILE COMMAND "@".
COMMENT .-----------------------------------------------------------.

;FILE INITIALIZATION.
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	LOOKUP 1,FILNAM↔HALT
	
;EXPAND CORE WHEN NECESSARY.
	HLRE PPPN↔MOVMS↔DAC SIZE#		;WORD COUNT.
	IMULI =5↔DAC CHRCNT			;NEW CHARACTER COUNT.
	LAC 1,TXTORG↔ADD 1,SIZE↔DAP 1,JOBFF	;NEW TOP OF CORE.
	CDR 1,JOBFF↔CAMG 1,JOBREL↔GO .+3	;EXPAND CORE.
	CORE 1,↔HALT

;INPUT THE FILE.
	CDR TXTORG↔HRLI 700↔DAC TXTPTR		;RESET TEXT POINTER.
	HLL PPPN↔DAC DUMARG			;DUMP MODE ARGUMENT.
	IN 1,DUMARG↔SKIPA↔HALT			;INPUT THE FILE.
	RELEASE 1,
	POP0J

	DUMARG:0↔0
ENDR INFILE;5/30/73(BGB)---------------------------------------------
FILNAM:	SIXBIT/ANA/
EXT:	0↔0
PPPN:	0↔0

CHRCNT:	0
TXTORG:	0
TXTPTR:	0
CHAR:	0
EOF:	0
PDL:	BLOCK 20

CNT2:	0

SUBR(GETCHR)
	SOSL CHRCNT↔GO[ILDB 1,TXTPTR↔JUMPE 1,.-1
	AOS CNT2↔DAC 1,CHAR↔POP0J]
	SETOM EOF↔SETZ 1,
	POP0J
ENDR GETCHR
SA:	
	LAC P,[IOWD 20,PDL]
	LAC JOBFF↔DAP TXTORG
	CALL(INFILE)
	DZM CNT
	CALL(GETCHR)↔CAIE 1,"⊗"↔GO .-2
	CALL(GETCHR)↔CAIE 1,"⊗"↔GO .-2
	CALL(GETCHR)↔CAIE 1,14↔GO .-2
	SETZM CNT2

L1:	CALL(GETCHR)
	SKIPE EOF↔GO L9
	CAIN 1," "↔GO L2	;WORD DELIMITER.
	CAIN 1,"{"↔GO L3	;XIP COMMANDS.
	GO L1

;SPACE WORD BREAK.
L2:	AOS CNT
	CALL(GETCHR)
	SKIPE EOF↔GO L9
	CAIN 1," "↔GO L2+1
	GO L1

;XIP COMMAND STRING.
L3:	CALL(GETCHR)
	SKIPE EOF↔GO L9
	CAIE 1,"}"↔GO L3
	GO L1

CNT:	0
CNT3:	0

L9:	MOVE 1,CNT
	IDIVI 1,=1000
	IDIVI 2,=100
	IDIVI 3,=10
	JUMPN 1,X1
	JUMPN 2,X2
	JUMPN 3,X3
	GO X4
X1:	ADDI 1,60↔OUTCHR 1
X2:	ADDI 2,60↔OUTCHR 2
X3:	ADDI 3,60↔OUTCHR 3
X4:	ADDI 4,60↔OUTCHR 4
	EXIT
END SA